home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0125_Linked List Management unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  3.3 KB  |  145 lines
  1. unit link;
  2. {$o-,g-,d-,l-,y-,q-,r-,s-,t-,v-,x-,n-,e-,b-}
  3.  
  4. INTERFACE
  5.  
  6. type
  7.   pstring=^string;
  8.   pdata=^tdatarec;
  9.   tdatarec=record
  10.              name:pstring;
  11.              size:byte;
  12.            end;
  13.   plink=^tlink;
  14.   tlink=record
  15.           prev,next:plink;
  16.           data:pdata;
  17.         end;
  18.  
  19. procedure inilink(var l:plink);
  20. function  addlink(var l:plink;var d:pdata):boolean;
  21. function  addlink2(var l:plink;var d:string):boolean;
  22. procedure dellink(var l:plink);
  23. procedure linkdata(var l:plink;var p:pdata);
  24. function  linkdata2(var l:plink):string;
  25. function  numlinks(var l:plink):longint;
  26. procedure killink(var l:plink);
  27.  
  28. IMPLEMENTATION
  29.  
  30. procedure inilink(var l:plink);
  31. begin
  32.   l^.prev:=nil; l^.next:=nil; l^.data:=nil; l:=nil;
  33. end;
  34.  
  35. function addlink(var l:plink;var d:pdata):boolean;
  36. begin
  37.   addlink:=false;
  38.   if(memavail<(d^.size+16))then exit;
  39.   if(l^.next=nil)then
  40.   begin
  41.     new(l^.next);
  42.     l^.next^.next:=nil;
  43.     l^.next^.prev:=l;
  44.     new(l^.next^.data);
  45.     getmem(l^.next^.data^.name,d^.size);
  46.     l^.next^.data^.name^:='';
  47.     l^.next^.data^.name^:=d^.name^;
  48. {    l^.next^.data^.name^[0]:=d[0];}
  49.     l^.next^.data^.size:=d^.size;
  50.   end else
  51.   begin
  52.     freemem(l^.next^.data^.name,l^.next^.data^.size);
  53.     getmem(l^.next^.data^.name,d^.size);
  54.     l^.next^.data^.name^:=d^.name^;
  55.     l^.next^.data^.size:=d^.size;
  56.   end;
  57.   addlink:=true;
  58.   l:=l^.next;
  59. end;
  60.  
  61. function addlink2(var l:plink;var d:string):boolean;
  62. begin
  63.   addlink2:=false;
  64.   if(memavail<(succ(ord(d[0])))+16)then exit;
  65.   if(l^.next=nil)then
  66.   begin
  67.     new(l^.next);
  68.     l^.next^.next:=nil;
  69.     l^.next^.prev:=l;
  70.     new(l^.next^.data);
  71.     getmem(l^.next^.data^.name,succ(ord(d[0])));
  72.     l^.next^.data^.name^:='';
  73.     l^.next^.data^.name^:=d;
  74.     l^.next^.data^.name^[0]:=d[0];
  75.     l^.next^.data^.size:=succ(ord(d[0]));
  76.   end else
  77.   begin
  78.     freemem(l^.next^.data^.name,l^.next^.data^.size);
  79.     getmem(l^.next^.data^.name,succ(ord(d[0])));
  80.     l^.next^.data^.name^:=d;
  81.     l^.next^.data^.size:=succ(ord(d[0]));
  82.   end;
  83.   addlink2:=true;
  84.   l:=l^.next;
  85. end;
  86.  
  87. procedure dellink(var l:plink);
  88. var tmp:plink;
  89. begin
  90.   tmp:=l;
  91.   if((tmp^.prev=nil)and(tmp^.next=nil))or(tmp^.data=nil)then exit;
  92.   if(tmp^.prev<>nil)and(tmp^.next<>nil)then tmp^.prev:=tmp^.next;
  93.   if(tmp^.prev<>nil)and(tmp^.next<>nil)then tmp^.next^.prev:=tmp^.prev;
  94.   l:=tmp^.next;
  95.   freemem(tmp^.data^.name,tmp^.data^.size);
  96.   dispose(tmp^.data);
  97.   dispose(tmp);
  98. end;
  99.  
  100. procedure linkdata(var l:plink;var p:pdata);
  101. begin
  102.   if(p=nil)then
  103.   begin
  104.     new(p);
  105.     new(p^.name);
  106.   end;
  107.   p^.name^:=l^.data^.name^;
  108. end;
  109.  
  110. function linkdata2(var l:plink):string;
  111. var tmp:string;
  112. begin
  113. {  tmp:=l^.data^.name^;
  114.   linkdata2:=tmp;      }
  115.   move(l^.data^.name^[1],tmp[1],succ(l^.data^.size));
  116.   tmp[0]:=char(pred(l^.data^.size));
  117.   linkdata2:=tmp;
  118. end;
  119.  
  120. function numlinks(var l:plink):longint;
  121. var
  122.   tmp:plink;
  123.   cnt:longint;
  124. begin
  125.   numlinks:=0;
  126.   if(l=nil)then exit;
  127.   tmp:=l;
  128.   while(tmp^.prev<>nil)do tmp:=tmp^.prev;
  129.   cnt:=1;
  130.   while(tmp^.next<>nil)do
  131.   begin
  132.     inc(cnt);
  133.     tmp:=tmp^.next;
  134.   end;
  135.   numlinks:=cnt;
  136. end;
  137.  
  138. procedure killink(var l:plink);
  139. var c:longint;
  140. begin
  141.   while(l^.prev<>nil)do l:=l^.prev;
  142.   for c:=1 to numlinks(l)do dellink(l);
  143. end;
  144.  
  145. end.